home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Pascal / Source□ / Talk Source / Talk ƒ / Talk.p < prev    next >
Encoding:
Text File  |  1992-04-20  |  8.3 KB  |  351 lines  |  [TEXT/PJMM]
  1. program Talk;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5.     uses
  6.         TalkdTypes, TCPTypes, TCPStuff, UDPStuff;
  7.  
  8.     label
  9.         999; { bail out }
  10.  
  11.     const
  12.         ctl_wait = 2;
  13.  
  14.     var
  15.         my_machine_addr, his_machine_addr: longInt;
  16.         my_machine_name, his_machine_name: str255;
  17.         my_name, his_name: userStr;
  18.         my_tty, his_tty: ttyStr;
  19.         ctl_socket, socket: integer;
  20.         invitation_waiting: boolean;
  21.         talkc: TCPConnectionPtr;
  22.         talkuc: UDPConnectionPtr;
  23.         dnrptr: ptr;
  24.         quitNow: boolean;
  25.  
  26.     procedure WNE (var er: eventRecord);
  27.         var
  28.             dummy: boolean;
  29.     begin
  30.         dummy := WaitNextEvent(everyEvent, er, 15, nil);
  31.         if er.what = keyDown then begin
  32.             if BAND(er.message, $FF) = ord('q') then
  33.                 quitNow := true;
  34.         end;
  35.     end;
  36.  
  37.     function AddrToName (ip: longInt; var name: str255): OSErr;
  38.         var
  39.             hi: hostInfo;
  40.             done: signedByte;
  41.             oe: OSErr;
  42.             er: eventRecord;
  43.     begin { XXX }
  44. {    oe := TCPAddrToName(dnrptr, m.ctl_addr.ip, hi, done);}
  45.  
  46.         TCPAddrToStr(dnrptr, ip, hi.rtnHostName);
  47.         oe := 0;
  48.         hi.rtnCode := oe;
  49.         done := 1;
  50.  
  51.         if oe = noErr then begin
  52.             while done = 0 do
  53.                 WNE(er);
  54.             oe := hi.rtnCode;
  55.         end;
  56.         name := hi.rtnHostName;
  57.         AddrToName := oe;
  58.     end;
  59.  
  60.     function OpenSocket: OSErr;
  61.         var
  62.             localhost, remotehost: longInt;
  63.             remoteport: integer;
  64.             available: longInt;
  65.             state: integer;
  66.             oe: OSErr;
  67.     begin
  68.         oe := TCPPassiveOpen(talkc, 0, 0, 0, nil);
  69.         if oe = noErr then begin
  70.             repeat
  71.                 TCPRawState(talkc, state, localhost, socket, remotehost, remoteport, available);
  72.             until socket <> 0;
  73.         end;
  74.         OpenSocket := oe;
  75.     end;
  76.  
  77.     function OpenCtl: OSErr;
  78.         var
  79.             oe: OSErr;
  80.     begin
  81.         ctl_socket := 0;
  82.         oe := UDPCreate(talkuc, 0, ctl_socket);
  83.         OpenCtl := oe;
  84.     end;
  85.  
  86.     procedure GetNames (user, tty, mach: str255);
  87.         var
  88.             rtnStruct: hostInfo;
  89.             done: signedByte;
  90.             oe: OSErr;
  91.             er: eventRecord;
  92.     begin
  93.         writeln('Talk to ', user, '@', mach, ' on tty ', tty);
  94.         oe := TCPGetMyIPAddr(my_machine_addr);
  95.         TCPAddrToStr(dnrptr, my_machine_addr, my_machine_name);
  96.         my_name := 'peteraaaaaaa';
  97.         my_name[6] := chr(0);
  98.         my_tty[1] := chr(0);
  99.  
  100.         oe := TCPStrToAddr(dnrptr, mach, rtnStruct, done);
  101.         if oe = noErr then begin
  102.             while done = 0 do
  103.                 WNE(er);
  104.             oe := rtnStruct.rtnCode;
  105.             his_machine_addr := rtnStruct.addrs[1];
  106.         end;
  107.         TCPAddrToStr(dnrptr, his_machine_addr, his_machine_name);
  108.         his_name := user;
  109.         his_tty := tty;
  110.     end;
  111.  
  112.     procedure CtlSend (target: longInt; id: integer; typ: ctlTypes);
  113.         var
  114.             m: ctlMsg;
  115.             oe: OSErr;
  116.     begin
  117.         writeln('Send to ', pointer(target), ',', id, ' - ', typ);
  118.         m.vers := talk_version;
  119.         m.typ := typ;
  120.         m.id_num := id;
  121.         m.l_name := my_name;
  122.         m.r_name := his_name;
  123.         m.r_tty := his_tty;
  124.         m.addr.family := AF_INET;
  125.         m.addr.ip := my_machine_addr;
  126.         m.addr.port := socket;
  127.         m.ctl_addr.family := AF_INET;
  128.         m.ctl_addr.ip := my_machine_addr;
  129.         m.ctl_addr.port := ctl_socket;
  130.         oe := UDPWrite(talkuc, target, talk_socket, @m, SizeOf(m), false);{target}
  131.     end;
  132.  
  133.     procedure CtlTransact (target: longInt; id: integer; typ: ctlTypes; var r: ctlResponse);
  134.         var
  135.             datap: ptr;
  136.             datalen: integer;
  137.             remoteIP, f: longInt;
  138.             remopteport: integer;
  139.             oe: OSErr;
  140.             er: eventRecord;
  141.     begin
  142.         writeln('CtlTransact to ', pointer(target), ',', id, ' - ', typ);
  143.         repeat
  144.             f := TickCount;
  145.             CtlSend(target, id, typ);
  146.             repeat
  147.                 if TickCount > f + 60 * ctl_wait then begin
  148.                     CtlSend(target, id, typ);
  149.                     f := TickCount;
  150.                 end;
  151.                 WNE(er);
  152.             until UDPDatagramsAvailable(talkuc) > 0;
  153.             repeat
  154.                 oe := UDPRead(talkuc, 2, remoteIP, remopteport, datap, datalen);
  155.                 if oe = noErr then begin
  156.                     if datalen <> SizeOf(r) then
  157.                         oe := -1
  158.                     else
  159.                         BlockMove(datap, @r, datalen);
  160.                     if datalen > 0 then
  161.                         oe := UDPReturnBuffer(talkuc, datap);
  162.                 end;
  163.             until (UDPDatagramsAvailable(talkuc) <= 0) or ((r.vers = talk_version) and (r.typ = typ));
  164.         until (r.vers = talk_version) and (r.typ = typ);
  165.         r.id_num := r.id_num;
  166.         r.addr.family := r.addr.family;
  167.         writeln('CtlTransact returns ', r.answer);
  168.     end;
  169.  
  170.     var
  171.         local_id, remote_id: integer;
  172.  
  173.     function GetAnswer (a: answers): str255;
  174.     begin
  175.         case a of
  176.             A_success: 
  177.                 GetAnswer := 'Success';
  178.             A_not_here: 
  179.                 GetAnswer := 'Your party is not logged on';
  180.             A_failed: 
  181.                 GetAnswer := 'Target machine is too confused to talk to us';
  182.             A_machine_unknown: 
  183.                 GetAnswer := 'Target machine does not recognize us';
  184.             A_permission_denied: 
  185.                 GetAnswer := 'Your party is refusing messages';
  186.             A_unknown_request: 
  187.                 GetAnswer := 'Target machine can not handle remote talk';
  188.             A_badversion: 
  189.                 GetAnswer := 'Target machine indicates protocol mismatch';
  190.             A_badaddr: 
  191.                 GetAnswer := 'Target machine indicates protocol botch (addr)';
  192.             A_badctladdr: 
  193.                 GetAnswer := 'Target machine indicates protocol botch (ctl_addr)';
  194.             otherwise
  195.                 GetAnswer := 'Unknown Answer';
  196.         end;
  197.     end;
  198.  
  199.     procedure AnnounceInvite (id: integer);
  200.         var
  201.             response: ctlresponse;
  202.     begin
  203.         CtlTransact(his_machine_addr, id, CT_announce, response);
  204.         remote_id := response.id_num;
  205.         if response.answer <> A_success then begin
  206.             writeln(GetAnswer(response.answer));
  207.             goto 999;
  208.         end;
  209.         CtlTransact(my_machine_addr, id, CT_leave_invite, response);
  210.         local_id := response.id_num;
  211.     end;
  212.  
  213.     procedure InviteRemote;
  214. { Wait for connection on talkc, then delete invitations }
  215.         var
  216.             f: longInt;
  217.             response: ctlResponse;
  218.             er: eventRecord;
  219.     begin
  220.         AnnounceInvite(-1);{id_num=}
  221.         invitation_waiting := true;
  222.         f := TickCount;
  223.         while (TCPState(talkc) = T_Listening) and not quitNow do begin
  224.             if TickCount > f + 60 * RING_WAIT then begin
  225.                 writeln('Ringing your party again');
  226.                 AnnounceInvite(remote_id + 1);
  227.                 f := TickCount;
  228.             end;
  229.             WNE(er);
  230.         end;
  231.         CtlTransact(my_machine_addr, local_id, CT_delete, response);
  232.         CtlTransact(his_machine_addr, remote_id, CT_delete, response);
  233.         invitation_waiting := false;
  234.     end;
  235.  
  236.     procedure SendDelete;
  237.     begin
  238.         CtlSend(his_machine_addr, remote_id, CT_delete);
  239.         CtlSend(my_machine_addr, local_id, CT_delete);
  240.     end;
  241.  
  242.     function LookForInvite (var r: ctlResponse): boolean;
  243.     begin
  244.         writeln('Checking for invitation on caller''s machine');
  245.         CtlTransact(his_machine_addr, remote_id, CT_lookup, r);
  246.         if r.answer = A_success then begin
  247.             remote_id := r.id_num;
  248.             LookForInvite := true;
  249.         end
  250.         else
  251.             LookForInvite := false;
  252.     end;
  253.  
  254.     function CheckLocal: boolean;
  255.         var
  256.             response: ctlResponse;
  257.             oe, ooe: OSErr;
  258.             er: eventRecord;
  259.     begin
  260.         writeln('CheckLocal');
  261.         if not LookForInvite(response) then begin
  262.             CheckLocal := false;
  263.             exit(CheckLocal);
  264.         end;
  265.         writeln('Waiting to connect with caller');
  266.         oe := TCPClose(talkc, @ooe);
  267.         while (oe = noErr) and (ooe = inProgress) do
  268.             WNE(er);
  269.         writeln(oe, ooe);
  270.         writeln(TCPRelease(talkc));
  271.         writeln(TCPActiveOpen(talkc, 0, response.addr.ip, response.addr.port, nil));
  272.         while TCPState(talkc) = T_WaitingForOpen do
  273.             WNE(er);
  274.         if TCPState(talkc) <> T_Established then begin
  275.             CtlTransact(his_machine_addr, remote_id, CT_delete, response);
  276.             writeln(OpenSocket);
  277.             CheckLocal := false;
  278.         end;
  279.     end;
  280.  
  281.     procedure Talk;
  282.         const
  283.             buf_siz = 50;
  284.         var
  285.             buf: string[buf_siz];
  286.             len: longInt;
  287.             er: eventRecord;
  288.             dummy: boolean;
  289.             oe: OSErr;
  290.     begin
  291.         if not quitNow then
  292.             writeln('Connection Established ', TCPSTate(talkc));
  293.         while not quitNow do begin
  294.             len := TCPCharsAvailable(talkc);
  295.             if len > 0 then begin
  296.                 if len > buf_siz then
  297.                     len := buf_siz;
  298. {$PUSH}
  299. {$R-}
  300.                 oe := TCPReceiveChars(talkc, @buf[1], len);
  301.                 buf[0] := chr(len);
  302.                 writeln('Received:', buf);
  303. {$POP}
  304.             end;
  305.             WNE(er);
  306.             if er.what = keyDown then begin
  307.                 writeln('Send:', chr(BAND(er.message, $FF)));
  308.                 oe := TCPSendAsync(talkc, ptr(longInt(@er.message) + 3), 1, nil);
  309.             end;
  310.         end;
  311.     end;
  312.  
  313.     var
  314.         oe, ooe: OSErr;
  315.         s: str255;
  316.         er: eventRecord;
  317.         r: rect;
  318.         ip: longInt;
  319. begin
  320.     SetRect(r, 10, 40, 500, 300);
  321. {    SetTextRect(r);}
  322.     ShowText;
  323.     quitNow := false;
  324.     writeln(UDPInit);
  325.     writeln(TCPInit);
  326.     s := '';
  327.     writeln(TCPOpenResolver(s, dnrptr));
  328.     invitation_waiting := false;
  329.     writeln(TCPGetMyIPAddr(ip));
  330.     if ip = $86073203 then
  331.         GetNames('peter', '', '134.7.50.4')
  332.     else
  333.         GetNames('peter', '', '134.7.50.3');
  334.     writeln(OpenCtl);
  335.     writeln(OpenSocket);
  336.     if not CheckLocal then
  337.         InviteRemote;
  338.     Talk;
  339. 999:
  340.     if invitation_waiting then
  341.         SendDelete;
  342.     oe := TCPClose(talkc, @ooe);
  343.     while (oe = noErr) and (ooe = inProgress) do
  344.         WNE(er);
  345.     writeln(oe, ooe);
  346.     writeln(TCPRelease(talkc));
  347.     writeln(UDPRelease(talkuc));
  348.     TCPCloseResolver(dnrptr);
  349.     TCPFinish;
  350.     UDPFinish;
  351. end.